
#Clear R
rm(list=ls())

#load necessary function
zero1 <- function(x, minx=NA, maxx=NA){
  res <- NA
  if(is.na(minx)) res <- (x - min(x,na.rm=T))/(max(x,na.rm=T) -min(x,na.rm=T))
  if(!is.na(minx)) res <- (x - minx)/(maxx -minx)
  res
}

#function to install packages if they don't exist
ipak <- function(pkg){
  new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
  if (length(new.pkg)) 
    install.packages(new.pkg, dependencies = TRUE)
  sapply(pkg, require, character.only = TRUE)
}

# usage
packages <- c("ggplot2", "lme4", "car","stargazer","dplyr","dtplyr","reshape2","moments","xtable", "psych", "psy", "QuantPsyc", "lavaan", "gridExtra")
ipak(packages)

load("wvs_sub.RData")

################
#
#Appendix C.3: Descriptive statistics
#
################

################
#Table C26: Study 3: Descriptive statistics Big Five trait
################
forsumstats <- with(wvs_sub,data.frame(nomem_encr, BFI_open,BFI_con,BFI_ext,BFI_agre,BFI_neu,Mini_IPIP_open,Mini_IPIP_con,Mini_IPIP_ext,Mini_IPIP_agre,Mini_IPIP_neu,IPIP_open,IPIP_con,IPIP_ext,IPIP_agre,IPIP_neu), na.rm=T)
forsumstats_long <- melt(forsumstats, id.vars="nomem_encr")
names(forsumstats_long)
forsumstats_long %>% group_by(variable) %>% summarise(Mean=mean(value,na.rm=T),SD=sd(value,na.rm=T),Skew=skewness(value,na.rm=T),Kurtosis=kurtosis(value,na.rm=T)) -> sumstats

BFI_alpha <- c(
  psych::alpha(data.frame(wvs_sub$open_item1,wvs_sub$open_item2))$total[2],
  psych::alpha(data.frame(wvs_sub$con_item1,wvs_sub$con_item2))$total[2],
  psych::alpha(data.frame(wvs_sub$ext_item1,wvs_sub$ext_item2))$total[2],
  psych::alpha(data.frame(wvs_sub$agre_item1,wvs_sub$agre_item2))$total[2],
  psych::alpha(data.frame(wvs_sub$neu_item1,wvs_sub$neu_item2))$total[2]) # ignore warnings

miniIPIP_alpha <- c(
  psych::alpha(with(wvs_sub,cbind(open2, open8, open9, open10)))$total[2],
  psych::alpha(with(wvs_sub,cbind(con3, con4, con8, con9)))$total[2],
  psych::alpha(with(wvs_sub,cbind(ext1, ext4, ext6, ext7)))$total[2],
  psych::alpha(with(wvs_sub,cbind(agre2, agre5, agre9, agre10)))$total[2],
  psych::alpha(with(wvs_sub,cbind(neu4, neu6, neu9, neu10)))$total[2])

IPIP_alpha <- c(
  psych::alpha(with(wvs_sub,cbind(open1, open2, open3, open4, open5, open6, open7, open8, open9, open10)))$total[2],
  psych::alpha(with(wvs_sub,cbind(con1, con2, con3, con4, con5, con6, con7, con8, con9, con10)))$total[2],
  psych::alpha(with(wvs_sub,cbind(ext1, ext2, ext3, ext4, ext5, ext6, ext7, ext8, ext9, ext10)))$total[2],
  psych::alpha(with(wvs_sub,cbind(agre1, agre2, agre3, agre4, agre5, agre6, agre7, agre8, agre9, agre10)))$total[2],
  psych::alpha(with(wvs_sub,cbind(neu1, neu2, neu3, neu4, neu5, neu6, neu7, neu8, neu9, neu10)))$total[2])

sumstatstable <-   data.frame(sumstats,alpha=unlist(c(BFI_alpha,miniIPIP_alpha,IPIP_alpha)))
sumstatstable$Battery <- c(rep("BFI",5),rep("Mini IPIP",5),rep("IPIP",5))
sumstatstable$Trait <- c("Openness","Concientiousness","Extraversion","Agreeableness","Neuroticism")
fort <- data.frame(sumstatstable[,7:8],sumstatstable[,2:6])
names(sumstatstable)

IPIP_var <- c(var(wvs_sub$IPIP_open, na.rm=T), var(wvs_sub$IPIP_con, na.rm=T),               var(wvs_sub$IPIP_ext, na.rm=T), var(wvs_sub$IPIP_agre, na.rm=T), var(wvs_sub$IPIP_neu, na.rm=T))

Mini_IPIP_var <- c(var(wvs_sub$Mini_IPIP_open, na.rm=T), var(wvs_sub$Mini_IPIP_con, na.rm=T),               var(wvs_sub$Mini_IPIP_ext, na.rm=T), var(wvs_sub$Mini_IPIP_agre, na.rm=T), var(wvs_sub$Mini_IPIP_neu, na.rm=T))

BFI_IPIP_var <- c(var(wvs_sub$BFI_open, na.rm=T), var(wvs_sub$BFI_con, na.rm=T),               var(wvs_sub$BFI_ext, na.rm=T), var(wvs_sub$BFI_agre, na.rm=T), var(wvs_sub$BFI_neu, na.rm=T))

sumstatstable_1 <-   data.frame(sumstatstable,var=unlist(c(BFI_IPIP_var,Mini_IPIP_var,IPIP_var)))
sumstatstable_1$Battery <- c(rep("BFI",5),rep("Mini IPIP",5),rep("IPIP",5))
sumstatstable_1$Trait <- c("Openness","Concientiousness","Extraversion","Agreeableness","Neuroticism")
fort <- data.frame(sumstatstable_1[,7:8],sumstatstable_1[c(2:5,9,6)])
names(sumstatstable_1)
print(xtable(fort),type="latex")

################
#Table C27-C31
################

#correlations between the three personality inventories
Open_cor <- cor(data<-(data.frame(wvs_sub$BFI_open, wvs_sub$Mini_IPIP_open, wvs_sub$IPIP_open)), use="complete.obs", method="pearson") 
upper<-Open_cor
upper[upper.tri(Open_cor)]<-""
upper<-as.data.frame(upper)
print(xtable(upper), type="latex")

cor(data<-(data.frame(wvs_sub$BFI_con, wvs_sub$Mini_IPIP_con, wvs_sub$IPIP_con)), use="complete.obs", method="pearson") 
cor(data<-(data.frame(wvs_sub$BFI_ext, wvs_sub$Mini_IPIP_ext, wvs_sub$IPIP_ext)), use="complete.obs", method="pearson") 
cor(data<-(data.frame(wvs_sub$BFI_agre, wvs_sub$Mini_IPIP_agre, wvs_sub$IPIP_agre)), use="complete.obs", method="pearson") 
cor(data<-(data.frame(wvs_sub$BFI_neu, wvs_sub$Mini_IPIP_neu, wvs_sub$IPIP_neu)), use="complete.obs", method="pearson") 

#############
#Table C32: Study 3: Convergent correlations between BFI and IPIP
#############

cor.test(wvs_sub$BFI_open,  wvs_sub$IPIP_open)
cor.test(wvs_sub$BFI_con,  wvs_sub$IPIP_open)
cor.test(wvs_sub$BFI_ext,  wvs_sub$IPIP_open)
cor.test(wvs_sub$BFI_agre,  wvs_sub$IPIP_open)
cor.test(wvs_sub$BFI_neu,  wvs_sub$IPIP_open)

cor.test(wvs_sub$BFI_open,  wvs_sub$IPIP_con)
cor.test(wvs_sub$BFI_con,  wvs_sub$IPIP_con)
cor.test(wvs_sub$BFI_ext,  wvs_sub$IPIP_con)
cor.test(wvs_sub$BFI_agre,  wvs_sub$IPIP_con)
cor.test(wvs_sub$BFI_neu,  wvs_sub$IPIP_con)

cor.test(wvs_sub$BFI_open,  wvs_sub$IPIP_ext)
cor.test(wvs_sub$BFI_con,  wvs_sub$IPIP_ext)
cor.test(wvs_sub$BFI_ext,  wvs_sub$IPIP_ext)
cor.test(wvs_sub$BFI_agre,  wvs_sub$IPIP_ext)
cor.test(wvs_sub$BFI_neu,  wvs_sub$IPIP_ext)

cor.test(wvs_sub$BFI_open,  wvs_sub$IPIP_agre)
cor.test(wvs_sub$BFI_con,  wvs_sub$IPIP_agre)
cor.test(wvs_sub$BFI_ext,  wvs_sub$IPIP_agre)
cor.test(wvs_sub$BFI_agre,  wvs_sub$IPIP_agre)
cor.test(wvs_sub$BFI_neu,  wvs_sub$IPIP_agre)

cor.test(wvs_sub$BFI_open,  wvs_sub$IPIP_neu)
cor.test(wvs_sub$BFI_con,  wvs_sub$IPIP_neu)
cor.test(wvs_sub$BFI_ext,  wvs_sub$IPIP_neu)
cor.test(wvs_sub$BFI_agre,  wvs_sub$IPIP_neu)
cor.test(wvs_sub$BFI_neu,  wvs_sub$IPIP_neu)

#cacluate mean diagnoal correlations = .45
(.45+.51+.53+.20+.64)/5
#cacluate mean off-diagnoal correlations = .10
(.00+.20+0+.19+.05+ .01+0.03+0.16+0.12+0.17+0.04+0.35+0.08+ 0.01+0.09+0.04+0.20+  0.15+0.15+0.14+0.01)/20
  

cor.test(wvs_sub$BFI_open,  wvs_sub$Mini_IPIP_open)
cor.test(wvs_sub$BFI_con,  wvs_sub$Mini_IPIP_open)
cor.test(wvs_sub$BFI_ext,  wvs_sub$Mini_IPIP_open)
cor.test(wvs_sub$BFI_agre,  wvs_sub$Mini_IPIP_open)
cor.test(wvs_sub$BFI_neu,  wvs_sub$Mini_IPIP_open)

cor.test(wvs_sub$BFI_open,  wvs_sub$Mini_IPIP_con)
cor.test(wvs_sub$BFI_con,  wvs_sub$Mini_IPIP_con)
cor.test(wvs_sub$BFI_ext,  wvs_sub$Mini_IPIP_con)
cor.test(wvs_sub$BFI_agre,  wvs_sub$Mini_IPIP_con)
cor.test(wvs_sub$BFI_neu,  wvs_sub$Mini_IPIP_con)

cor.test(wvs_sub$BFI_open,  wvs_sub$Mini_IPIP_ext)
cor.test(wvs_sub$BFI_con,  wvs_sub$Mini_IPIP_ext)
cor.test(wvs_sub$BFI_ext,  wvs_sub$Mini_IPIP_ext)
cor.test(wvs_sub$BFI_agre,  wvs_sub$Mini_IPIP_ext)
cor.test(wvs_sub$BFI_neu,  wvs_sub$Mini_IPIP_ext)

cor.test(wvs_sub$BFI_open,  wvs_sub$Mini_IPIP_agre)
cor.test(wvs_sub$BFI_con,  wvs_sub$Mini_IPIP_agre)
cor.test(wvs_sub$BFI_ext,  wvs_sub$Mini_IPIP_agre)
cor.test(wvs_sub$BFI_agre,  wvs_sub$Mini_IPIP_agre)
cor.test(wvs_sub$BFI_neu,  wvs_sub$Mini_IPIP_agre)

cor.test(wvs_sub$BFI_open,  wvs_sub$Mini_IPIP_neu)
cor.test(wvs_sub$BFI_con,  wvs_sub$Mini_IPIP_neu)
cor.test(wvs_sub$BFI_ext,  wvs_sub$Mini_IPIP_neu)
cor.test(wvs_sub$BFI_agre,  wvs_sub$Mini_IPIP_neu)
cor.test(wvs_sub$BFI_neu,  wvs_sub$Mini_IPIP_neu)

#cacluate mean diagnoal correlations = .45
(.45+.46+.50+.21+.58)/5
#cacluate mean off-diagnoal correlations = .10
(.04+.17+0.18+.06+0.04+0.04+0.13+0.13+0.15+0.03+0.27+0.08+0.03+0.13+0.04+0.16+0.15+0.16+0.10+0.02)/20
    
##############
#Table C34: Study 3: Kolmogorov-Smirnov test comparing distributions of BFI and IPIP
##############
ks.test(wvs_sub$BFI_open, wvs_sub$IPIP_open)
ks.test(wvs_sub$BFI_con, wvs_sub$IPIP_con)
ks.test(wvs_sub$BFI_ext, wvs_sub$IPIP_ext)
ks.test(wvs_sub$BFI_agre, wvs_sub$IPIP_agre)
ks.test(wvs_sub$BFI_neu, wvs_sub$IPIP_neu)

##############
#Table C35: Study 3: Kolmogorov-Smirnov test comparing distributions of BFI and Mini IPIP
##############
ks.test(wvs_sub$BFI_open, wvs_sub$Mini_IPIP_open)
ks.test(wvs_sub$BFI_con, wvs_sub$Mini_IPIP_con)
ks.test(wvs_sub$BFI_ext, wvs_sub$Mini_IPIP_ext)
ks.test(wvs_sub$BFI_agre, wvs_sub$Mini_IPIP_agre)
ks.test(wvs_sub$BFI_neu, wvs_sub$Mini_IPIP_neu)


######################
#Figure C12: Study 3: Distributions of the Big Five traits using diferent batteries
######################

#Openness
forggplot_open <- melt(wvs_sub,measure.vars = c("BFI_open","Mini_IPIP_open","IPIP_open")) 
p1<- ggplot(forggplot_open,aes(x=value,colour=variable, fill=variable)) +  scale_colour_manual(values=c("red","chartreuse2", "blue")) + labs(title="Openness", x="Openness", y="Frequency") +geom_histogram(, binwidth=.02, alpha=1, position=position_dodge()) + scale_fill_manual(values=c("red","chartreuse2", "blue"), labels=c("BFI", "Mini-IPIP","IPIP"), guide=guide_legend(title = "Battery"))  + guides(colour=FALSE) + theme_bw()

#Conscientiousness
forggplot_con <- melt(wvs_sub,measure.vars = c("BFI_con","Mini_IPIP_con","IPIP_con")) 
p2<-ggplot(forggplot_con,aes(x=value,colour=variable, fill=variable)) +  scale_colour_manual(values=c("red","chartreuse2", "blue")) + labs(title="Conscientiousness", x="Conscientiousness", y="Frequency") +geom_histogram(, binwidth=.02, alpha=1, position=position_dodge()) + scale_fill_manual(values=c("red","chartreuse2", "blue"), labels=c("BFI", "Mini-IPIP","IPIP"), guide=guide_legend(title = "Battery"))  + guides(colour=FALSE) + theme_bw()

#Extraversion
forggplot_ext <- melt(wvs_sub,measure.vars = c("BFI_ext","Mini_IPIP_ext","IPIP_ext")) 
p3<-ggplot(forggplot_ext,aes(x=value,colour=variable, fill=variable)) +  scale_colour_manual(values=c("red","chartreuse2", "blue")) + labs(title="Extraversion", x="Extraversion", y="Frequency") +geom_histogram(, binwidth=.02, alpha=1, position=position_dodge()) + scale_fill_manual(values=c("red","chartreuse2", "blue"), labels=c("BFI", "Mini-IPIP","IPIP"), guide=guide_legend(title = "Battery"))  + guides(colour=FALSE) + theme_bw()

#Agreeableness
forggplot_agre <- melt(wvs_sub,measure.vars = c("BFI_agre","Mini_IPIP_agre","IPIP_agre")) 
p4<-ggplot(forggplot_agre,aes(x=value,colour=variable, fill=variable)) +  scale_colour_manual(values=c("red","chartreuse2", "blue")) + labs(title="Agreeableness", x="Agreeableness", y="Frequency") +geom_histogram(, binwidth=.02, alpha=1, position=position_dodge()) + scale_fill_manual(values=c("red","chartreuse2", "blue"), labels=c("BFI", "Mini-IPIP","IPIP"), guide=guide_legend(title = "Battery"))  + guides(colour=FALSE) + theme_bw()

#Neuroticism
forggplot_neu <- melt(wvs_sub,measure.vars = c("BFI_neu","Mini_IPIP_neu","IPIP_neu")) 
p5<-ggplot(forggplot_neu,aes(x=value,colour=variable, fill=variable)) +  scale_colour_manual(values=c("red","chartreuse2", "blue")) + labs(title="Neuroticism", x="Neuroticism", y="Frequency") +geom_histogram(, binwidth=.02, alpha=1, position=position_dodge()) + scale_fill_manual(values=c("red","chartreuse2", "blue"), labels=c("BFI", "Mini-IPIP","IPIP"), guide=guide_legend(title = "Battery"))  + guides(colour=FALSE) + theme_bw()

#creat plot
grid.arrange(p1, p2, p3, p4, p5, ncol=2)
ggsave("TIPI_Study/R3_combined.pdf",arrangeGrob(p1, p2, p3, p4, p5))


################
#
#Table C36: Study 3: Factor loadings of the Big Five traits
#
################

#factor score B5: acceptable fit
B5<-'Open = ~ NA*open1+ open2+open3+open4+open5+open6+open7+open8+open9+open10 
Con = ~NA*con1+con2+con3+con4+con5+con6+con7+con8+con9+con10
Ext = ~NA*ext1+ext2+ext3+ext4+ext5+ext6+ext7+ext8+ext9+ext10
Agre= ~NA*agre1+agre2+agre3+agre4+agre5+agre6+agre7+agre8+agre9+agre10
Neu= ~NA*neu1+neu2+neu3+neu4+neu5+neu6+neu7+neu8+neu9+neu10
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu'

#assess fit & take into account categorical nature of the variables
fit<-cfa(B5,data=wvs_sub)
summary(fit, fit.measures=TRUE, standardized=T) 
inspect(fit,what="std")

################
#
#Appendix C.4: Factor structure of ideology
#
################

##################################
#structural equation models
##################################

#2 dimensional
Ideology<-'Cultural = ~ NA*gay1 + gay2 + purity + abortion + euthanasia + immigration 
Econ = ~NA*redistribution1+redistribution2+govrespon
Cultural ~~ 1*Cultural
Econ ~~1*Econ'
#assess fit
fit<-cfa(Ideology,data=wvs_sub, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"))
summary(fit, fit.measures=TRUE, standardized=T)
inspect(fit,what="std")

#1 dimension
Ideology1<-'Ideology = ~ NA*gay1 + gay2 + purity + abortion + euthanasia + immigration + redistribution1+redistribution2+govrespon
Ideology~~1*Ideology'
#assess fit
fit<-cfa(Ideology1,data=wvs_sub, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"), missing="listwise")
summary(fit, fit.measures=TRUE, standardized=T)

################
#C.5 Study 3: Descriptive statistics
################

#gender
table(wvs_sub$gender)
#percentage female
(723*100)/1419

#age
summary(wvs_sub$age)
sd(wvs_sub$age, na.rm=T)
#age2
mean(wvs_sub$age2, na.rm=T)
sd(wvs_sub$age2, na.rm=T)

#Education = 1670
table(wvs_sub$education)
(93*100)/1419
(330*100)/1419
(140*100)/1419
(329*100)/1419
(371*100)/1419
(156*100)/1419

#income
table(wvs_sub$income_categories)
(127*100)/1419
(265*100)/1419
(275*100)/1419
(235*100)/1419
(182*100)/1419
(258*100)/1419
(77*100)/1419

################
#
#Appendix C.5: Regression output models in Figure 5
#
################

#BFI moral attitudes
t1 <- lm(wvs_moral~BFI_open+BFI_con+BFI_neu+BFI_agre+BFI_ext+gender+age+age2+as.factor(education)+as.factor(income_categories),data=wvs_sub)
#BFI economic attitudes
t2 <- lm(wvs_economicattitudes~BFI_open+BFI_con+BFI_neu+BFI_agre+BFI_ext+gender+age+age2+as.factor(education)+as.factor(income_categories),data=wvs_sub)
#BFI Left right placement
t3 <- lm(wvs_lrplacement~BFI_open+BFI_con+BFI_neu+BFI_agre+BFI_ext+gender+age+age2+as.factor(education)+as.factor(income_categories),data=wvs_sub)

#BFI 10: regression results
stargazer(t3, t1, t2, title="BFI results", align=TRUE, 
          dep.var.labels=c("Uni-dimensional ideology", "Cultural ideology", "Ecoonomic ideology"), 
          omit.stat=c("LL","ser","f", "adj.rsq"), 
          star.cutoffs=c(0.05), 
          covariate.labels =c("Openness", "Conscientiousness", "Neuroticism", "Agreeableness", "Extraversion", "Female", "Age", "Age-squared", "Intermediate Secondary", "Higher Secondary", "Intermediate Vocational", "Higher Vocational", "University", "1500<2500", "2500<3500", "3500<4500", "4500<5500", ">5500", "Missing", "Constant"),
          notes = "Unstandardized coefficients from OLS Regession models; *p<0.05", 
          notes.append = FALSE, 
          no.space=TRUE)

#Mini IPIP moral attitudes (gay rights)
mi1 <- lm(wvs_moral~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_neu+Mini_IPIP_agre +Mini_IPIP_ext+gender+age+age2+as.factor(education)+as.factor(income_categories), data=wvs_sub)
#Mini IPIP economic attitudes
mi2 <- lm(wvs_economicattitudes~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_neu+Mini_IPIP_agre +Mini_IPIP_ext+gender+age+age2+as.factor(education)+as.factor(income_categories), data=wvs_sub)
#Mini IPIP Left right placement
mi3 <- lm(wvs_lrplacement~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_neu+Mini_IPIP_agre +Mini_IPIP_ext+gender+age+age2+as.factor(education)+as.factor(income_categories), data=wvs_sub)

#Mini IPIP: regression results
stargazer(mi3, mi1, mi2, title="Mini-IPIP: Associations between personality and ideology as reported in Figure 5", align=TRUE, 
          dep.var.labels=c("Uni-dimensional", "Cultural", "Ecoonomic"), 
          omit.stat=c("LL","ser","f", "adj.rsq"), 
          covariate.labels =c("Openness", "Conscientiousness", "Neuroticism", "Agreeableness", "Extraversion", "Female", "Age", "Age-squared", "Intermediate Secondary", "Higher Secondary", "Intermediate Vocational", "Higher Vocational", "University", "1500<2500", "2500<3500", "3500<4500", "4500<5500", ">5500", "Missing", "Constant"),
          star.cutoffs=c(0.05), 
          notes = "OLS Regession models; *p<0.05", 
          notes.append = FALSE, 
          no.space=TRUE)

# Full IPIP moral attitudes
i1 <- lm(wvs_moral~IPIP_open+IPIP_con+IPIP_neu+ IPIP_agre+IPIP_ext+gender+age+age2+as.factor(education)+as.factor(income_categories), data=wvs_sub)
# Full IPIP economic attitudes
i2 <- lm(wvs_economicattitudes~IPIP_open+IPIP_con+IPIP_neu+ IPIP_agre+IPIP_ext+gender+age+age2+as.factor(education)+as.factor(income_categories), data=wvs_sub)
# Full IPIP Left right placement
i3 <- lm(wvs_lrplacement~IPIP_open+IPIP_con+IPIP_neu+ IPIP_agre+IPIP_ext+gender+age+age2+as.factor(education)+as.factor(income_categories), data=wvs_sub)


#IPIP FFM: regression results
stargazer(i3, i1, i2, title="IPIP: Associations between personality and ideology as reported in Figure 5", align=TRUE, 
          dep.var.labels=c("Uni-dimensional ideology", "Cultural ideology", "Ecoonomic ideology"), 
          omit.stat=c("LL","ser","f", "adj.rsq"), 
          star.cutoffs=c(0.05), 
          covariate.labels =c("Openness", "Conscientiousness", "Neuroticism", "Agreeableness", "Extraversion", "Female", "Age", "Age-squared", "Intermediate Secondary", "Higher Secondary", "Intermediate Vocational", "Higher Vocational", "University", "1500<2500", "2500<3500", "3500<4500", "4500<5500", ">5500", "Missing", "Constant"),
          notes = "Note: Unstandardized coefficients from OLS Regession models; *p<0.05", 
          notes.append = FALSE, 
          no.space=TRUE)

################
#
#Appendix C..7 Study 3: Standardized coefficients
#
################

t2 <- lm(wvs_lrplacement~BFI_open+BFI_con+BFI_neu+BFI_agre+ BFI_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
t2.beta<-lm.beta(t2)

m2 <- lm(wvs_lrplacement~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_neu+Mini_IPIP_agre+Mini_IPIP_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
m2.beta<-lm.beta(m2)

i2 <- lm(wvs_lrplacement~IPIP_open+IPIP_con+IPIP_neu+IPIP_agre+IPIP_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
i2.beta<-lm.beta(i2)

t1 <- lm(wvs_moral~BFI_open+BFI_con+BFI_neu+BFI_agre+ BFI_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
t1.beta<-lm.beta(t1)

m1 <- lm(wvs_moral~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_neu+Mini_IPIP_agre+Mini_IPIP_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
m1.beta<-lm.beta(m1)

i1 <- lm(wvs_moral~IPIP_open+IPIP_con+IPIP_neu+IPIP_agre+IPIP_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
i1.beta<-lm.beta(i1)

t3 <- lm(wvs_economicattitudes~BFI_open+BFI_con+BFI_neu+BFI_agre+ BFI_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
t3.beta<-lm.beta(t3)

m3 <- lm(wvs_economicattitudes~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_neu+Mini_IPIP_agre+Mini_IPIP_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
m3.beta<-lm.beta(m3)

i3 <- lm(wvs_economicattitudes~IPIP_open+IPIP_con+IPIP_neu+IPIP_agre+IPIP_ext+gender+age+age2+edu2+edu3+edu4+edu5+edu6+income2+income3+income4+income5+income6+income7,data=wvs_sub)
m3.beta  <-lm.beta(i3)

################
#
#Appendix C.8: Models without education and income
#
################

#BFI moral attitudes
t1 <- lm(wvs_moral~BFI_open+BFI_con+BFI_ext+BFI_agre+BFI_neu+gender+age+age2,data=wvs_sub)
#BFI economic attitudes
t2 <- lm(wvs_economicattitudes~BFI_open+BFI_con+BFI_ext+BFI_agre+BFI_neu+gender+age+age2,data=wvs_sub)
#BFI Left right placement
t3 <- lm(wvs_lrplacement~BFI_open+BFI_con+BFI_ext+BFI_agre+BFI_neu+gender+age+age2,data=wvs_sub)

#Mini IPIP moral attitudes (gay rights)
mi1 <- lm(wvs_moral~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_ext+Mini_IPIP_agre+Mini_IPIP_neu+gender+age+age2, data=wvs_sub)
#Mini IPIP economic attitudes
mi2 <- lm(wvs_economicattitudes~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_ext+Mini_IPIP_agre+Mini_IPIP_neu+gender+age+age2, data=wvs_sub)
#Mini IPIP Left right placement
mi3 <- lm(wvs_lrplacement~Mini_IPIP_open+Mini_IPIP_con+Mini_IPIP_ext+Mini_IPIP_agre+Mini_IPIP_neu+gender+age+age2, data=wvs_sub)

# Full IPIP moral attitudes
i1 <- lm(wvs_moral~IPIP_open+IPIP_con+IPIP_ext+IPIP_agre+IPIP_neu+gender+age+age2, data=wvs_sub)
# Full IPIP economic attitudes
i2 <- lm(wvs_economicattitudes~IPIP_open+IPIP_con+IPIP_ext+IPIP_agre+IPIP_neu+gender+age+age2, data=wvs_sub)
# Full IPIP Left right placement
i3 <- lm(wvs_lrplacement~IPIP_open+IPIP_con+IPIP_ext+IPIP_agre+IPIP_neu+gender+age+age2, data=wvs_sub)

#moral attitudes
moralattitudes <- data.frame(rbind(summary(t1)$coefficients[c(2:6),1:2],summary(i1)$coefficients[c(2:6),1:2],summary(mi1)$coefficients[c(2:6),1:2]))
moralattitudes$trait <- c("Openness","Conscientiousness","Extraversion","Agreeableness","Neuroticism")
moralattitudes$scale <- c(rep("BFI",5),rep("IPIP",5),rep("Mini-IPIP",5))
colnames(moralattitudes)[2]="se"

# economic attitudes
economicattitudes <- data.frame(rbind(summary(t2)$coefficients[c(2:6),1:2],summary(i2)$coefficients[c(2:6),1:2],summary(mi2)$coefficients[c(2:6),1:2]))
economicattitudes$trait <- c("Openness","Conscientiousness","Extraversion","Agreeableness","Neuroticism")
economicattitudes$scale <- c(rep("BFI",5),rep("IPIP",5),rep("Mini-IPIP",5))
colnames(economicattitudes)[2]="se"

# left-right behavior
lrbehavior <- data.frame(rbind(summary(t3)$coefficients[c(2:6),1:2],summary(i3)$coefficients[c(2:6),1:2],summary(mi3)$coefficients[c(2:6),1:2]))
lrbehavior$trait <- c("Openness","Conscientiousness","Extraversion","Agreeableness","Neuroticism")
lrbehavior$scale <- c(rep("BFI",5),rep("IPIP",5),rep("Mini-IPIP",5))
colnames(lrbehavior)[2]="se"

forggplot <- rbind(cbind(lrbehavior,DV='Unidimensional \n Ideology'), cbind(moralattitudes,DV='Cultural \n Ideology'),cbind(economicattitudes,DV='Economic \n Ideology'))
forggplot$scale <- factor(forggplot$scale,levels=c("BFI","Mini-IPIP","IPIP"))
forggplot$trait <- factor(forggplot$trait,levels=(c("Openness","Conscientiousness","Neuroticism","Agreeableness","Extraversion")))

#create plot
ggplot(subset(forggplot), aes(x=scale,y=Estimate))+facet_grid(trait~DV,scales = "free")+geom_pointrange(aes(x=scale,ymin=Estimate-1.96*se,ymax=Estimate+1.96*se))+theme_bw()+theme(axis.text.x = element_text(angle = -45, hjust = 0))+geom_hline(yintercept = 0,colour="red")+xlab("Battery")+geom_errorbar(aes(x=scale,ymin=Estimate-1.96*se,ymax=Estimate+1.96*se),width=.2)+geom_point()+theme(text=element_text(size=10))+coord_fixed()

######################3
#
#Appendix C.9 Structural Equation Models
#
#########################

CFA_B5<-  'Open = ~ NA*open1+ open2+open3+open4+open5+open6+open7+open8+open9+open10 
Con = ~NA*con1+con2+con3+con4+con5+con6+con7+con8+con9+con10
Ext = ~NA*ext1+ext2+ext3+ext4+ext5+ext6+ext7+ext8+ext9+ext10
Agre= ~NA*agre1+agre2+agre3+agre4+agre5+agre6+agre7+agre8+agre9+agre10
Neu= ~NA*neu1+neu2+neu3+neu4+neu5+neu6+neu7+neu8+neu9+neu10
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu'

#Assess fit of the model
fit_CFA_B5<-cfa(CFA_B5, ordered=c("open1", "open2", "open3", "open4", "open5", "open6", "open7", "open8", "open9", "open10", "con1", "con2", "con3", "con4", "con5", "con6", "con7", "con8", "con9", "con10", "ext1", "ext2", "ext3", "ext4", "ext5", "ext6", "ext7", "ext8", "ext9", "ext10", "agre1", "agre2", "agre3", "agre4", "agre5", "agre6", "agre7", "agre8", "agre9", "agre10", "neu1", "neu2", "neu3", "neu4", "neu5", "neu6", "neu7", "neu8", "neu9", "neu10"), data=wvs_sub)
#Extract coefficients
summary(fit_CFA_B5, fit.measures=TRUE,  standardized=T)
inspect(fit_CFA_B5,what="std")

################
#IPIP FFM: Uni-dimensional ideology
################

LRIPIP<-  'Open = ~ NA*open1+ open2+open3+open4+open5+open6+open7+open8+open9+open10 
Con = ~NA*con1+con2+con3+con4+con5+con6+con7+con8+con9+con10
Ext = ~NA*ext1+ext2+ext3+ext4+ext5+ext6+ext7+ext8+ext9+ext10
Agre= ~NA*agre1+agre2+agre3+agre4+agre5+agre6+agre7+agre8+agre9+agre10
Neu= ~NA*neu1+neu2+neu3+neu4+neu5+neu6+neu7+neu8+neu9+neu10
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu

#Regress
wvs_lrplacement ~ Open+Con+Ext+Agre+Neu+gender+age+age2+income2+income3+income4+income5+income6+income7+edu2+edu3+edu4+edu5+edu6'

#Assess fit of the model
fit_LRIPIP<-sem(LRIPIP, data=wvs_sub)

#Extract coefficients
summary(fit_LRIPIP, fit.measures=TRUE, standardized=T)

################
#IPIP FFM: Cultural ideology
################

SocialIPIP<-  'Open = ~ NA*open1+ open2+open3+open4+open5+open6+open7+open8+open9+open10 
Con = ~NA*con1+con2+con3+con4+con5+con6+con7+con8+con9+con10
Ext = ~NA*ext1+ext2+ext3+ext4+ext5+ext6+ext7+ext8+ext9+ext10
Agre= ~NA*agre1+agre2+agre3+agre4+agre5+agre6+agre7+agre8+agre9+agre10
Neu= ~NA*neu1+neu2+neu3+neu4+neu5+neu6+neu7+neu8+neu9+neu10
Social = ~ purity+ gay1+ gay2+ abortion+ euthanasia+ immigration
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu

#Regress
Social ~ Open+Con+Ext+Agre+Neu+gender+age+age2+income2+income3+income4+income5+income6+income7+edu2+edu3+edu4+edu5+edu6'

#Assess fit of the model
fit_SocialIPIP<-sem(SocialIPIP, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"), data=wvs_sub)
#Extract coefficients
summary(fit_SocialIPIP, fit.measures=TRUE,  standardized=T)

################
#IPIP FFM: Economic ideology
################

EconIPIP<-  'Open = ~ NA*open1+ open2+open3+open4+open5+open6+open7+open8+open9+open10 
Con = ~NA*con1+con2+con3+con4+con5+con6+con7+con8+con9+con10
Ext = ~NA*ext1+ext2+ext3+ext4+ext5+ext6+ext7+ext8+ext9+ext10
Agre= ~NA*agre1+agre2+agre3+agre4+agre5+agre6+agre7+agre8+agre9+agre10
Neu= ~NA*neu1+neu2+neu3+neu4+neu5+neu6+neu7+neu8+neu9+neu10
Econ = ~redistribution1+ govrespon+ redistribution2
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu

#Regress
Econ ~ Open+Con+Ext+Agre+Neu+gender+age+age2+income2+income3+income4+income5+income6+income7+edu2+edu3+edu4+edu5+edu6'

#Assess fit of the model
fit_EconIPIP<-sem(EconIPIP, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"), data=wvs_sub)

#Extract coefficients
summary(fit_EconIPIP, fit.measures=TRUE, standardized=T)

#############################################################3
#Mini-IPIP
##############################################################

################
#Mini_IPIP: Uni-dimensional ideology
################
Mini_LRIPIP<-  'Open = ~NA*open2+ open8+ open9+ open10  
Con = ~NA*con8 +con3+ con4+ con9 
Ext = ~NA*ext1+ ext6+ ext7+ ext4
Agre= ~NA*agre2+ agre5+ agre9+ agre10
Neu= ~NA*neu4+ neu6+ neu9+ neu10
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu

#Regress
wvs_lrplacement ~ Open+Con+Ext+Agre+Neu+gender+age+age2+income2+income3+income4+income5+income6+income7+edu2+edu3+edu4+edu5+edu6'

#Assess fit of the model
fit_Mini_LRIPIP<-sem(Mini_LRIPIP, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"), data=wvs_sub)

#Extract coefficients
summary(fit_Mini_LRIPIP, fit.measures=TRUE, standardized=T)


################
#Mini_IPIP: Cultural ideology
################
Mini_SocialIPIP<-  'Open = ~NA*open2+ open8+ open9+ open10  
Con = ~NA*con8 +con3+ con4+ con9 
Ext = ~NA*ext1+ ext6+ ext7+ ext4
Agre= ~NA*agre2+ agre5+ agre9+ agre10
Neu= ~NA*neu4+ neu6+ neu9+ neu10
Social = ~ purity+ gay1+ gay2+ abortion+ euthanasia+ immigration
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu

#Regress
Social ~ Open+Con+Ext+Agre+Neu+gender+age+age2+income2+income3+income4+income5+income6+income7+edu2+edu3+edu4+edu5+edu6'

#Assess fit of the model
fit_Mini_SocialIPIP<-sem(Mini_SocialIPIP, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"), data=wvs_sub)
#Extract coefficients
summary(fit_Mini_SocialIPIP, fit.measures=TRUE,  standardized=T)

################
#Mini IPIP: Economic ideology
################

MiniEconIPIP<-  'Open = ~NA*open2+ open8+ open9+ open10  
Con = ~NA*con8 +con3+ con4+ con9 
Ext = ~NA*ext1+ ext6+ ext7+ ext4
Agre= ~NA*agre2+ agre5+ agre9+ agre10
Neu= ~NA*neu4+ neu6+ neu9+ neu10
Econ = ~redistribution1+ govrespon+ redistribution2
Open~~1*Open
Con~~1*Con
Ext~~1*Ext
Agre~~1*Agre
Neu~~1*Neu

#Regress
Econ ~ Open+Con+Ext+Agre+Neu+gender+age+age2+income2+income3+income4+income5+income6+income7+edu2+edu3+edu4+edu5+edu6'

#Assess fit of the model
fit_Mini_EconIPIP<-sem(MiniEconIPIP, ordered=c("gay1", "gay2", "purity", "euthanasia", "immigration", "redistribution2"), data=wvs_sub)

#Extract coefficients
summary(fit_Mini_EconIPIP, fit.measures=TRUE, standardized=T)

############################################
#Appendix C.10 - see "Study3_results.R"
############################################

############################################
#Appendix C.11 - see "Study3_results.R"
############################################